Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/vbalyz/mfuncs.bas

BASIC Source File | 1995-01-05 | 21KB | 840 lines

Option Explicit

Global Const APP_NAME = "VB*Alyzer"

Dim mblnProjectSelected As Integer
Dim mstrProjectName  As String

Dim mstraProjFile() As String

Type Metric_Type
    Name As String
    LongName As String
    Display As Integer
End Type

Dim muaMetric(1 To 20) As Metric_Type

Type FileStats_Type
    Filename As String
    Metric(1 To 20)  As Single
    CurrentBeginEndLevel As Integer
    CurrentFunc As String
    CurrentComplexity As Integer
    WorstRoutine As String
End Type

Type Status_Type
    InRoutine As Integer
    InType As Integer
End Type

Dim muStatus As Status_Type

Const TOTSIZE = 1
Const TOTLINES = 2
Const BLANKLINES = 3
Const TOTCOMMENTS = 4
Const TOTROUTINES = 5
Const PRIVATEROUTINES = 6
Const LOCALVARS = 7
Const LOCALCONSTS = 8
Const MODULEVARS = 9
Const MODULECONSTS = 10
Const GLOBALVARS = 11
Const GLOBALCONSTS = 12
Const APIDECS = 13
Const TYPES = 14
Const TYPELINES = 15
Const AVERTNLINES = 16
Const RTNNONCODELINES = 17
Const ROUTINECODELINES = 18
Const ROUTINEDECPTS = 19
Const MOSTCOMPLEX = 20

Dim muTotStat As FileStats_Type

Sub AccumTotals (uStatIn As FileStats_Type)

' Add the values in the supplied stat record to the total record

Dim i As Integer

    For i = LBound(uStatIn.Metric) To UBound(uStatIn.Metric)
        If i <> MOSTCOMPLEX Then
            muTotStat.Metric(i) = muTotStat.Metric(i) + uStatIn.Metric(i)
        Else
            ' MostComplex should be a maximum
            If muTotStat.Metric(i) < uStatIn.Metric(i) Then
                muTotStat.Metric(i) = uStatIn.Metric(i)
            End If
        End If
    Next

End Sub

Sub AnalyzeCurrentProject (lst As Control, grd As Grid)

Dim i As Integer

    Screen.MousePointer = HOURGLASS

    ' Reset output grid
    ClearWholeGrid grd
    grd.Rows = 1
    SetGridHeadings grd

    ZeroProjectTotals

    ' For each file in list, take it apart
    For i = 0 To lst.ListCount - 1
        AnalyzeFile lst.List(i), grd
    Next

    ' Display stats
    ReportStats muTotStat, grd

    Screen.MousePointer = DEFAULT

End Sub

Sub AnalyzeFile (ByVal strFile As String, grd As Grid)

Dim intF As Integer
Dim strLine As String
Dim uStat As FileStats_Type

    intF = FreeFile

    Open strFile For Input As intF

    muStatus.InRoutine = False
    uStat.Filename = strFile

    Do
        Line Input #intF, strLine
        AnalyzeLine strLine, uStat
    Loop Until EOF(intF)

    ' Check last routine's complexity
    If muStatus.InRoutine Then
        CheckComplexity uStat, strLine
    End If

    Close intF

    ReportStats uStat, grd

    AccumTotals uStat

End Sub

Sub AnalyzeLine (ByVal strLine As String, uStat As FileStats_Type)

' This is the main engine for the whole metric part of the program
' It's not very nice, and should probably be broken up. Sooner rather
' than later.

    ' Add Line lingth to total size
    uStat.Metric(TOTSIZE) = uStat.Metric(TOTSIZE) + Len(strLine)

    ' Remove leading/trailing spaces
    strLine = Trim$(strLine)

    ' If working on a form, ignore control description info,
    ' identifiable by "Begin" and "End". Keep track of current
    ' "level": while > 0 we're still working in the uninteresting
    ' part of the file.
    If Right$(uStat.Filename, 3) = "FRM" Then
        If IsLeftEnd(strLine, "Begin") Then
            uStat.CurrentBeginEndLevel = uStat.CurrentBeginEndLevel + 1
            Exit Sub
        End If
        If uStat.CurrentBeginEndLevel > 0 Then
            If IsLeftEnd(strLine, "End") Then
                uStat.CurrentBeginEndLevel = uStat.CurrentBeginEndLevel - 1
                Exit Sub
            End If
        End If
        If uStat.CurrentBeginEndLevel > 0 Then
            Exit Sub
        End If
    End If

    ' Increment total lines
    inc uStat, TOTLINES

    ' If blank line, increment blank count
    If Len(strLine) = 0 Then
        inc uStat, BLANKLINES
        ' If blank is in a routine, increment non-code line count
        If muStatus.InRoutine Then
            inc uStat, RTNNONCODELINES
        End If
        Exit Sub
    End If

    ' If comment... (Note no allowance made for trailing comments)
    If Left$(strLine, 1) = "'" Then
        inc uStat, TOTCOMMENTS
        If muStatus.InRoutine Then
            inc uStat, RTNNONCODELINES
        End If
        Exit Sub
    End If

    If IsLeftEnd(strLine, "Private") Then
        inc uStat, PRIVATEROUTINES
        StripLeftmostWord strLine
    End If

    ' Check current line for being a routine (= Sub or Function)
    If IsRoutine(strLine) Then

        muStatus.InRoutine = True
        inc uStat, TOTROUTINES

        CheckComplexity uStat, strLine

        ' Uses McCabe complexity metric, counting decision points.
        ' A routine's Decision Pt count is always 1, even if
        ' there's nothing else of significance in the routine
        inc uStat, ROUTINEDECPTS
        uStat.CurrentComplexity = 1

        ' Get routine name by removing the Sub or Function part...
        StripLeftmostWord strLine

        ' ...and taking the next word
        uStat.CurrentFunc = LeftMostWord(strLine)

        Exit Sub
    End If

    ' Are we defining a variable?
    If IsLeftEnd(strLine, "Dim") Then
        If muStatus.InRoutine Then
            inc uStat, LOCALVARS
            inc uStat, RTNNONCODELINES
        Else
            inc uStat, MODULEVARS
        End If
        Exit Sub
    End If

    ' How about a Constant?
    If IsLeftEnd(strLine, "Const") Then
        If muStatus.InRoutine Then
            inc uStat, LOCALCONSTS
            inc uStat, RTNNONCODELINES
        Else
            inc uStat, MODULECONSTS
        End If
        Exit Sub
    End If

    ' Is something being defined globally?
    If IsLeftEnd(strLine, "Global") Then
        ' Is it a constant?
        If InStr(strLine, " Const ") Then
            inc uStat, GLOBALCONSTS
        Else
        ' If not, it must be a variable of some sort
            inc uStat, GLOBALVARS
        End If
        Exit Sub
    End If

    ' Check for API declarations (includes all DLL links)
    If IsLeftEnd(strLine, "Declare Sub") Or IsLeftEnd(strLine, "Declare Function") Then
        inc uStat, APIDECS
        Exit Sub
    End If

    ' If we're not currently processing a Type, then check to see
    ' if one's just turned up...
    If Not muStatus.InType Then
        ' If it has, then record the fact
        If IsLeftEnd(strLine, "Type") Then
            muStatus.InType = True
            inc uStat, TYPES
            Exit Sub
        End If
    End If

    ' if we're in a Type declaration,
    If muStatus.InType Then
        ' Check for the end of it
        If IsLeftEnd(strLine, "End Type") Then
            muStatus.InType = False
            inc uStat, TYPELINES
        Else
            inc uStat, TYPELINES
        End If
        Exit Sub
    End If

    ' If we're in a routine, check this line for decision
    ' points.
    If muStatus.InRoutine Then
        CountDecisionPoints strLine, uStat
        ' Since we've got this far, and exited earlier if
        ' non-"action code" lines were encountered, it's a
        ' reasonable bet that this line _is_ "action code"
        inc uStat, ROUTINECODELINES
    End If

End Sub

Sub CheckComplexity (uStat As FileStats_Type, strLine As String)

    ' if in a routine, check to see if the last routine was more complex
    ' than that currently stored
    If muStatus.InRoutine Then
        If uStat.CurrentComplexity > uStat.Metric(MOSTCOMPLEX) Then
            uStat.Metric(MOSTCOMPLEX) = uStat.CurrentComplexity
            uStat.WorstRoutine = uStat.CurrentFunc
        End If
    End If

End Sub

Sub ClearProjectFileList ()

    ReDim mstraProjFile(1 To 1)

End Sub

Sub CountDecisionPoints (ByVal strLine As String, uStat As FileStats_Type)

Dim intDecPts As Integer

    ' Check for lines beginning Select Case/For/Do/While
    If